home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 2 / ETO Development Tools 2.iso / Essentials / Developer Essentials Nov 90 / Apple II / Apple.II.partition / Utilities / Desk.Accs / PD.NDAs / SHOWCLIP / CLIP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-21  |  6.9 KB  |  275 lines  |  [TEXT/pdos]
  1. {$DeskAcc 70 -1 'Show Clipboard' }
  2. {$LongGlobals+}
  3.  
  4. program ClipNDA;
  5. {
  6.   A public-domain NDA by David A. Lyons.
  7.   Watch for Shareware from:
  8.     DAL Systems
  9.     P.O. Box 287
  10.     North Liberty IA 52317
  11.     
  12.     [CompuServe 72177,3233]
  13.     [GEnie mail   D.LYONS2]
  14.  
  15.   Version 1.1:  Fixed bug where MyID was not being set when
  16.                 it was used to start up the Font Manager.
  17. }
  18.  
  19. uses
  20.   QDIntf, GSIntf, MiscTools, FontMgr;
  21.  
  22. const
  23.   ScrapTool = $16;
  24.   FontTool  = $1B;
  25.   QDAuxTool = $12;
  26.  
  27. var
  28.   myWindOpen:   boolean;
  29.   myWind:       NewWindowParamBlk;
  30.   myWindPtr:    WindowPtr;
  31.   OldCount:     integer;
  32.   FMDirPage:    ptr;
  33.   MyID:         integer;
  34.   LoadedSM, StartedSM,
  35.   LoadedFM, StartedFM,
  36.   LoadedQX, StartedQX: boolean;
  37.   
  38. function ScrapAvail: boolean;
  39. begin
  40.   ScrapAvail := (ScrapStatus<>0) and (ToolErrorNum=0);
  41. end;
  42.  
  43. function QXAvail: boolean;
  44. begin
  45.   QXAvail := (QDAuxStatus<>0) and (ToolErrorNum=0);
  46. end;
  47.  
  48. function FMAvail: boolean;
  49. begin
  50.   FMAvail := (FMStatus<>0) and (ToolErrorNum=0);
  51. end;
  52.  
  53. function OKtoDraw: boolean;
  54. begin
  55.   OKtoDraw := QXAvail and FMAvail;
  56. end;
  57.  
  58. procedure DoInfo;
  59. const
  60.   NumL = 10;
  61. var
  62.   myStr: array[1..NumL] of String[50];
  63.   i: integer;
  64.   return: char;
  65. begin
  66.   if not ScrapAvail then exit;
  67.   return := char(13);
  68.   myStr[1] := 'Clipboard v1.1 by David A. Lyons';
  69.   myStr[2] := '';
  70.   myStr[3] := 'A Public Domain NDA from:';
  71.   myStr[4] := '  DAL Systems';
  72.   myStr[5] := '  P.O. Box 287';
  73.   myStr[6] := '  North Liberty, IA 52317';
  74.   myStr[7] := '';
  75.   myStr[8] := '  [CompuServe  72177,3233]';
  76.   myStr[9] := '  [GEnie mail    D.LYONS2]';
  77.   myStr[10]:= '  [AppleLinkPE Dave Lyons]';
  78.   ZeroScrap;
  79.   for i := 1 to NumL do begin
  80.     PutScrap(length(myStr[i]),0,@myStr[i][1]);
  81.     PutScrap(1,0,@return);
  82.   end;
  83. end; { DoInfo }
  84.  
  85. procedure SetupTools;
  86. var
  87.   dummy: integer;
  88. begin
  89.   { prepare to use Scrap Manager }
  90.   dummy := ScrapVersion;
  91.   if (ToolErrorNum>0) and (ToolErrorNum<$10) then begin
  92.     LoadOneTool(ScrapTool,$0100);
  93.     if ToolErrorNum=0 then LoadedSM := true;
  94.   end;
  95.   if (ScrapStatus=0) and (ToolErrorNum=0) then begin
  96.     ScrapStartup;
  97.     if ToolErrorNum=0 then StartedSM := true;
  98.   end;
  99.   { prepare to use Font Manager }
  100.   dummy := FMVersion;
  101.   if (ToolErrorNum>0) and (ToolErrorNum<$10) then begin
  102.     LoadOneTool(FontTool,$0100);
  103.     if ToolErrorNum=0 then LoadedFM := true;
  104.   end;
  105.   dummy := FMStatus;
  106.   if (dummy=0) and (ToolErrorNum=0) then begin
  107.     FMDirPage := NewHandle($100,MyID+$100,$C015,nil)^;
  108.     if ToolErrorNum=0 then begin
  109.       FMStartup(MyID+$100,LoWord(FMDirPage));
  110.       if ToolErrorNum=0 then StartedFM := true;
  111.     end;
  112.   end;
  113.   { prepare to use QuickDraw Auxiliary }
  114.   dummy := QDAuxVersion;
  115.   if (ToolErrorNum>0) and (ToolErrorNum<$10) then begin
  116.     LoadOneTool(QDAuxTool,$0100);
  117.     if ToolErrorNum=0 then LoadedQX := true;
  118.   end;
  119.   if (QDAuxStatus=0) and (ToolErrorNum=0) then begin
  120.     QDAuxStartup;
  121.     if ToolErrorNum=0 then StartedQX := true;
  122.   end;
  123. end;
  124.  
  125. procedure FinishTools;
  126. begin
  127.   if StartedQX and (QDAuxStatus<>0) and (ToolErrorNum=0) then
  128.     QDAuxShutDown;
  129.   if LoadedQX then UnloadOneTool(QDAuxTool);
  130.   if StartedFM and (FMStatus<>0) and (ToolErrorNum=0) then
  131.     FMShutdown;
  132.   if LoadedFM  then UnloadOneTool(FontTool);
  133.   if StartedSM and (ScrapStatus<>0) and (ToolErrorNum=0) then
  134.     ScrapShutdown;
  135.   if LoadedSM then UnloadOneTool(ScrapTool);
  136.   DisposeAll(MyID+$100);
  137. end;
  138.  
  139. function DAOpen: WindowPtr;
  140. begin
  141.   SetupTools;
  142.   if myWindOpen then  
  143.     SelectWindow(myWindPtr)
  144.   else begin
  145.     fillchar(myWind,sizeof(NewWindowParamBlk),0);
  146.     with myWind do begin
  147.        param_length := sizeof(NewWindowParamBlk);
  148.        wFrame       := $DDA0;
  149.        wTitle       := @' Clipboard NDA ';
  150.        SetRect(wPosition,30,30,300,128);
  151.        wPlane       := -1;
  152.        wStorage     := nil;
  153.     end;
  154.     myWindPtr := NewWindow(myWind);   { Open NDA }
  155.     SetSysWindow(myWindPtr);          { Make a system window }
  156.   end;
  157.   DAOpen     := myWindPtr;          { Return pointer }
  158.   myWindOpen := true;               { Set flag to true }
  159.   OldCount   := -1;
  160.   LoadScrap;
  161. {  if ScrapAvail then if GetScrapSize(0)=0 then DoInfo; }
  162. end;
  163.  
  164. procedure DAClose;
  165. begin
  166.    if myWindOpen then CloseWindow(myWindPtr);
  167.    myWindOpen := false;
  168. end;
  169.  
  170. procedure DrawContent;
  171. const
  172.    textscrap = 0;
  173.    picscrap  = 1;
  174. var
  175.    currPort: GrafPtr;
  176.    TextHand:   Handle;
  177.    PicHand:    PicHandle;
  178.    tLength, pLength: longint;
  179.    r: rect;
  180. begin
  181.    if not ScrapAvail then exit;
  182.    currPort := GetPort;
  183.    SetPort(myWindPtr);
  184.    PicHand   := PicHandle(GetScrapHandle(picscrap));
  185.    TextHand  := GetScrapHandle(textscrap);
  186.    pLength   := GetScrapSize(picscrap);
  187.    if ToolErrorNum<>0 then pLength := 0;
  188.    tLength    := GetScrapSize(textscrap);
  189.    if ToolErrorNum<>0 then tLength := 0;
  190.    SetRect(r,0,0,10000,10000);
  191.    EraseRect(r);
  192.    if OKtoDraw and (pLength<>0) then begin { draw picture }
  193.      r := PicHand^^.PicFrame;
  194.      OffsetRect(r,-r.left,-r.top);
  195.      if odd(PicHand^^.PicFrame.left) then OffsetRect(r,1,0);
  196.      OffsetRect(r,10,5);
  197.      DrawPicture(PicHand,r);
  198.    end else begin
  199.      SetForeColor(0);
  200.      SetBackColor(15);
  201.      HLock(TextHand);
  202.      SetRect(r,10,5,10000,10000);
  203.      LETextBox2(TextHand^,tLength,r,0);
  204.      HUnlock(TextHand);
  205.    end; { draw text }
  206.    SetPort(currPort);
  207. end;
  208.  
  209. procedure DAAction(Code: Integer; Param: EventRecordPtr);
  210. var
  211.    what, modifiers:  Integer;
  212.    key: char;
  213. begin
  214.    case Code of
  215.       DAEvent:
  216.        begin
  217.           what := param^.what;
  218.           case what of
  219.             updateEvt: begin
  220.               BeginUpdate(myWindPtr);
  221.               DrawContent;
  222.               EndUpdate(myWindPtr);
  223.             end;
  224.             KeyDown: begin
  225.               key := char(LoWord(param^.message));
  226.               modifiers := param^.modifiers;
  227.               if bitand(AppleKey,modifiers)<>0 then begin
  228.                 if (Key='c') or (Key='C') or
  229.                    (Key='x') or (Key='X') then DoInfo
  230.                 else
  231.                   SysBeep;
  232.               end
  233.             end;
  234.          end;
  235.        end;
  236.       DARun: if ScrapAvail then begin
  237.                if OldCount<>GetScrapCount then
  238.                  DrawContent;
  239.                OldCount := GetScrapCount;
  240.              end else begin
  241.                MoveTo(10,20);
  242.                DrawString('[Scrap Manager not available]');
  243.              end;
  244.       DACursor,   {  Do nothing for these }
  245.       DAMenu, 
  246.       DAUndo,
  247.       DAClear:  Code := 1;
  248.       DACopy, DACut:  begin
  249.                         DoInfo;
  250.                         Code := 1;
  251.                       end;
  252.       DAPaste:        Code := 1;
  253.    end;
  254. end; { of DAAction }
  255.  
  256. { The first call will be a ShutDown call made by the ProDOS
  257.   loader.  We just assume that globals are initialized to 0! }
  258. procedure DAInit(Code: Integer);
  259. begin
  260.   MyID := MMStartUp;
  261.   if code<>0 then begin { start up }
  262.     LoadedSM := false;  StartedSM := false;
  263.     LoadedFM := false;  StartedFM := false;
  264.     LoadedQX := false;  StartedQX := false;
  265.     myWindOpen := false;
  266.   end else begin { shut down }
  267.     if myWindOpen then DAClose;
  268.     FinishTools;
  269.   end;
  270. end; { DAInit }
  271.  
  272. begin 
  273.   { No main program with NDA's }
  274. end.
  275.